Grapevine 18/Grapevine 18 (Disk 2 of 3).adf/LookHere/AREXXtut.lha/Grapevine/ondisk/gv_convert.rexx

OS/2 REXX Batch file | 1980-01-30 | 8.0 KB | 286 lines

/* Grapevine article conversion AREXX script */
/* R.J.Osbaldeston          v1.00, July 1993 */

arg filename dst_filename options

/* ++ PROCESS PARAMETERS ++ */
If arg()=0 Then Do
   Say 'Please enter the article filename: '
   pull filename
   End
If dst_filename == '' Then Do
   dst_filename = filename||'.cnv'
   End

/* ++ Open GV article for read, and an output file for writing ++ */
success = open('src_handle',filename,'r')
If success = 0 Then Do
   Say 'Unable to open that Article!'
   exit
   End
Else Do
   src_line = Readln('src_handle')
                                       /* Do a quick check on the file type */
   If Left(src_line,10) ~= '----------' Then Do
      Say 'ERROR: File Format, Not A Recognised Grapvine Article.'
      exit
      End
   End

success = open('dst_handle',dst_filename,'w')
If success = 0 Then Do
   Say 'Unable to open article destination.'
   exit
   End

do_title = 1                              /* check for command line options */
If index(options,'/NO_TITLE')>0 Then do_title=0


/* ++ INITIALIZE VARIABLES ++ */
page_brk = copies('-',80)                            /* page break constant */
lf_token1 = 'FF'x                           /* alternating linefeed token 1 */
lf_token2 = 'FE'x                           /* alternating linefeed token 2 */
lf_toggle_known = 0
lf_toggle_tmp = 0
pages_read = 0                                 /* number of pages processed */
lf_toggle_col1 = 0              /* flags used to keep track of linefeeds .. */
lf_toggle_col2 = 0              /* .. while writing to destination.         */


call time 'R'                             /* Reset timer, start timing now! */
Say 'Working'

call process_header                 /* Process the Grapevine article header */


Do While ~eof('src_handle')

   first_col_buffer  = ''
   second_col_buffer = ''
   lf_toggle_known = 0
   lf_toggle_tmp = 0
   lines_read = 0

   If (do_title & pages_read=0) Then call process_title

                   /* process a text section, until End of the current page
                      or the End of the source file, or buffer overflow.    */

   /* ++ PROCESS A PAGE ++ */
   Do While (~eof('src_handle'))

      src_line = Trim(Readln('src_handle'))

      If src_line = page_brk Then Leave

/* --- If Substr(src_line,39,2) ~= '  ' Then say '*' src_line --- */

      /* ++ PROCESS FIRST COLUMN ++ */
      column_txt = Trim(Left(src_line,40))

      If length(column_txt)=0 Then
         Do
         first_col_buffer = first_col_buffer||'0A'x
         If lf_toggle_col1 Then first_col_buffer = first_col_buffer||'0A'x
         lf_toggle_col1 = 0
         End
      Else
         Do
         If lf_toggle_col1 Then
            first_col_buffer = first_col_buffer||column_txt||'0A'x
         Else
            first_col_buffer = first_col_buffer||column_txt||' '
         lf_toggle_col1 = ~lf_toggle_col1
         End


      /* ++ PROCESS SECOND COLUMN ++ */
      column_txt=Delstr(src_line,1,40)

      If Words(column_txt)=0 Then
         Do
         second_col_buffer = second_col_buffer||'0A'x

         If lf_toggle_known Then
            Do
             If lf_toggle_col2 Then second_col_buffer = second_col_buffer||'0A'x
            End
         Else
            Do
                       /* .. PROBLEM, lf_toggle not known at this point,and
                          this will occationally cause an extra linefeed    */

             second_col_buffer = second_col_buffer||'0A'x
             lf_toggle_known = 1
            End
         lf_toggle_col2 = 0
         End
      Else
         Do
         If lf_toggle_known Then
            Do
            If lf_toggle_col2 Then
               second_col_buffer = second_col_buffer||column_txt||'0A'x
            Else
               second_col_buffer = second_col_buffer||column_txt||' '
            lf_toggle_col2= ~lf_toggle_col2
            End
         Else
            Do
            If lf_toggle_tmp Then
               second_col_buffer = second_col_buffer||column_txt||lf_token2
            Else
               second_col_buffer = second_col_buffer||column_txt||lf_token1
            lf_toggle_tmp = ~lf_toggle_tmp
            End
         End

      lines_read = lines_read + 1
      End


   /* +++ PROCESS TEMP LF_TOKEN REPLACEMENT, FOR SECOND COLUMN +++ */
   If lf_toggle_col1 Then
   Do
      ctrl_command1 = '0A'x
      ctrl_command2 = ' '
   End
   Else
   Do
      ctrl_command1 = ' '
      ctrl_command2 = '0A'x
   End

   lf_pos = pos(lf_token1,second_col_buffer)
   Do While lf_pos ~= 0
      second_col_buffer = overlay(ctrl_command1,second_col_buffer,lf_pos)
      lf_pos = pos(lf_token1,second_col_buffer,lf_pos)
   End

   lf_pos = pos(lf_token2,second_col_buffer)
   Do While lf_pos ~= 0
      second_col_buffer = overlay(ctrl_command2,second_col_buffer,lf_pos)
      lf_pos = pos(lf_token2,second_col_buffer,lf_pos)
   End


   /* ++ WRITE PROCESSED PAGE, FIRST COLUMN PLUS SECOND ++ */
   Writech('dst_handle',first_col_buffer||second_col_buffer);


   /* ++ HANDLE NEXT PAGE LF TOGGLES ++ */
   If ~lf_toggle_known Then
   Do
      If lf_toggle_tmp Then lf_toggle_col1 = 1 Else lf_toggle_col1 = 0
   End
   Else
   Do
      lf_toggle_col1 = lf_toggle_col2
   End

   pages_read = pages_read + 1
   Say '.'                                      /* keep the user interested */

                                 /* Check wether this is the End of article */
   If lines_read < 2 Then Leave
   End                                         /* ..Otherwise continue loop */

Close('src_handle')                    /* close files, free memory and exit */
Close('dst_handle')

Say 'Finished. <' pages_read 'Pages, Time taken' time('E')||'s >'
Say ''
Exit

/* ------------------------------------------------------------------------ */

process_header: PROCEDURE

   prev_pos = Seek('src_handle',0,'B')
   header_line1 = Readln('src_handle')

   Writeln('dst_handle',header_line1)

   header_line2 = Readln('src_handle')
   Do while (Left(header_line2,10) ~= '----------')
      Writeln('dst_handle',header_line2)
      prev_pos = Seek('src_handle',0,'C')
      header_line2 = Readln('src_handle')
      End

   Writeln('dst_handle',header_line1)


             /* Often there is no LF after the End of the header and the
                start of the title, check for this and reset the file
                pointer appropriatley                                      */

   If length(header_line2) > 80 Then Do
      curr_pos = Seek('src_handle',prev_pos,'B')
      header_line2 = Readch('src_handle',80)
      End

Return(1)

/* ------------------------------------------------------------------------ */

process_title: PROCEDURE EXPOSE lines_read lines_written do_title

prev_pos = Seek('src_handle',0,'C')
title_line = Readln('src_handle')
lines_read = lines_read + 1

Do While (lines_read<8 & ,
          (Words(title_line)=0 |,
           Substr(title_line,39,2) ~= '  ' |,
           check_leading(title_line) |,
           check_upper() |,
           check_dspace()))

   If length(title_line)<77 Then
      Do
        title_line = Strip(title_line,'B')
        Writeln('dst_handle', Centre(title_line,77))
      End
   Else
        Writeln('dst_handle',title_line)

   prev_pos = Seek('src_handle',0,'C')
   title_line = Readln('src_handle')
   lines_read = lines_read + 1
   End

curr_pos = Seek('src_handle',prev_pos,'B')
lines_read = lines_read - 1

Return(1)

/* ------------------------------------------------------------------------ */

check_dspace: EXPOSE title_line
/* check wether characters are Doubled spaced */
If Words(title_line)=0 Then Return(0)
Do word_loop=1 To Words(title_line)
   If WordLength(title_line, word_loop) ~= 1 Then Return(0)
   End
Return(1)

check_upper: EXPOSE title_line
/* check wether characters are all upper case */
If Words(title_line)=0 Then Return(0)
Do word_loop=1 To Length(title_line)
   If Substr(title_line,word_loop,1) >= 'a' &,
      Substr(title_line,word_loop,1) <= 'z' Then Return(0)
   End
Return(1)


/* ------------------------------------------------------------------------ */

check_leading:
arg line_text
/* check for leading spaces in line */
If WordIndex(line_text,1) > 1 Then Return(1)
Return(0)